home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1998 July
/
EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso
/
earkit
/
news
/
thor
/
hd-install
/
thor.lha
/
rexx
/
BBSRead
/
SaveMessage.br
< prev
next >
Wrap
Text File
|
1997-08-29
|
10KB
|
392 lines
/*
** $VER: SaveMessage.br 1.01 (13.5.97)
** by Eirik Nicolai Synnes
**
** See SortMail.guide for documentation
**
*/
options results
options failat 31
parse arg arguments
/*
** Initialize some variables
*/
version = subword(sourceline(2), 4, 1)
template = 'SYSTEM/A,CONFERENCE/A,MSGNO/A/N,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S'
globals = 'args. data. head. text. fileopen filemode destname destfile downloadpath BBSREAD.LASTERROR myerr globals'
fileopen = 0
/*
** Find/open BBSREAD ARexx port
*/
if ~(show('P', 'BBSREAD')) then do
address(command)
'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
if exists('SYS:RexxC/WaitForPort') then 'SYS:RexxC/WaitForPort BBSREAD'
else 'WaitForPort BBSREAD'
if (rc = 5) then do; say 'Could not open BBSREAD''s ARexx port.'; exit(30); end
if (rc ~= 0) then do; say 'Could not find SYS:Rexxc/WaitForPort.'; exit(30); end
end
/*
** Give template if arguments = '?'
*/
if arguments = '?' then do
say 'Usage: 'template
say 'SplitDigest.br is an external script for SortMail.'
exit(5)
end
address(bbsread)
'READARGS TEMPLATE "'template'" STEM 'args' CMDLINE 'arguments
if (rc ~= 0) then do
say BBSREAD.LASTERROR
say 'Template: 'template
say 'SaveMessage.br is an external script for SortMail.'
exit(5)
end
/*
** Find download path
*/
address(bbsread)
'GETBBSDATA "'args.SYSTEM'" STEM 'bbsdata
if (rc ~= 0) then signal error
if (symbol('bbsdata.DNLOADPATH') ~= 'VAR') | (bbsdata.DNLOADPATH = '') then do
'GETGLOBALDATA 'globaldata
if (rc ~= 0) then signal error
downloadpath = globaldata.DNLOADPATH
end
else downloadpath = bbsdata.DNLOADPATH
if (right(downloadpath, 1) ~= ':') & (right(downloadpath, 1) ~= '/') then downloadpath = downloadpath'/'
/*
** Find path, filename and mode of output file
*/
if (symbol('args.FILENAME') = 'VAR') & (symbol('args.DIRECTORY') = 'VAR') then do
myerr = 'Both DIRECTORY/K and FILENAME/K were specified.'; rc = 20; signal error
end
if ~(symbol('args.FILENAME') = 'VAR') & ~(symbol('args.DIRECTORY') = 'VAR') then do
myerr = 'Neither DIRECTORY/K nor FILENAME/K were specified.'; rc = 20; signal error
end
if (symbol('args.FILENAME') = 'VAR') then do
destfile = args.FILENAME
if (args.APPEND) & (exists(destfile)) then filemode = 'A'
else filemode = 'W'
destfile = args.FILENAME
end
if (symbol('args.DIRECTORY') = 'VAR') then do
'READBRMESSAGE "'args.SYSTEM'" "'args.CONFERENCE'" 'args.msgno' HEADSTEM 'head
if (rc ~= 0) then signal error
destfile = head.SUBJECT
if (symbol('args.SUBSTITUTE') = 'VAR') then do
if (symbol('args.WITH') = 'VAR') then do
if (index(destfile, args.SUBSTITUTE) = 0) then do
myerr = 'Substitution string not found in subject'; rc = 20; signal error
end
destfile = substitute(destfile, args.SUBSTITUTE, args.WITH)
end
else do; myerr = 'SUBSTITUTE/K needs WITH/K.'; rc = 20; signal error; end
end
/* Strip unwanted characters and "Re: " from subject */
destfile = compress(destfile, '*')
destfile = compress(destfile, '#')
destfile = compress(destfile, '?')
destfile = compress(destfile, '`')
destfile = compress(destfile, '/')
destfile = compress(destfile, ':')
do while upper(left(destfile, 3)) = 'RE '
if upper(left(destfile, 3)) = 'RE ' then destfile = substr(destfile, 4)
end
if right(destname, 1) ~= ':' & right(destname, 1) ~= '/' then destname = destname'/'
destfile = args.DIRECTORY || destfile
if (args.APPEND) & (exists(destfile)) then filemode = 'A'
else filemode = 'W'
end
/*
** See if there is a Thor ARexx port we can shanghai
*/
ports = show('P')
do i = 1 to words(ports)
if pos(' THOR.', ports) > 0 then thorport = word(substr(ports, pos(' THOR.', ports)), 1)
end
/*
** Save the message using Thor's SAVEMESSAGE if available, otherwise my own
*/
if (symbol('thorport') = 'VAR') then do
if ~(args.NOBIN) then do
'READBRMESSAGE "'args.SYSTEM'" "'args.CONFERENCE'" 'args.msgno' TEXTSTEM 'text
if rc ~= 0 then signal error
call checkbin('text', downloadpath)
end
saveargs = ''
if ~(args.HEADER) then saveargs = saveargs' NOHEADER'
if ~(args.APPEND) then saveargs = saveargs' OVERWRITE'
address(thorport)
'SAVEMESSAGE BBSNAME "'args.SYSTEM'" CONFNAME "'args.CONFERENCE'" MSGNR 'args.MSGNO' FILE "'destfile'" 'saveargs
if (rc ~= 0) then signal error
end
else do
'READBRMESSAGE "'args.SYSTEM'" "'args.CONFERENCE'" 'args.msgno' TEXTSTEM 'text' HEADSTEM 'head
if (rc ~= 0) then signal error
call savemsg('head', 'text')
end
returned = 0; signal cleanup
/*
** Some error detection stuff
*/
error:
syntax:
returned = rc
select
when symbol('BBSREAD.LASTERROR') = 'VAR' then say 'Line 'sigl' returned 'returned': 'BBSREAD.LASTERROR
when symbol('myerr') = 'VAR' then say 'Line 'sigl' returned 'returned': 'myerr
otherwise say 'Line 'sigl' returned 'returned': 'errortext(returned)
end
break_c:
halt:
cleanup:
/*
** Close output file if open
*/
if (fileopen) then do
call close(of)
fileopen = 0
end
exit(returned)
/****************************************************************************
******************* Check if a message contains binary parts ******************
****************************************************************************/
checkbin: interpret 'procedure expose 'globals
parse arg tstem, downloadpath
/*
** Check for message parts
*/
if (symbol(tstem'.PART.COUNT') = 'VAR') then do
parts = value(tstem'.PART.COUNT')
if (parts > 0) then do i = 1 to parts
if (symbol(tstem'.PART.'i'.BINARY') = 'VAR') then do
if (exists(value(tstem'.PART.'i'.BINARY'))) then do
address(command)
'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
if (rc ~= 0) then do; myerr = 'Failed to copy binary part to download directory.'; rc = 20; signal error; end
address(bbsread)
end
end
else do
usestem = tstem'.PART.'i'.MSG'
call checkbin(usestem, downloadpath)
end
end
end
return(0)
/****************************************************************************
*************** Recursive procedure for writing message to file ***************
****************************************************************************/
savemsg: interpret 'procedure expose 'globals
parse arg hstem, tstem
/*
** Open file for writing/appending
*/
if ~(fileopen) then do
fileopen = open(of, destfile, filemode)
if (fileopen) & (filemode = 'A') then call writeln(of, copies('=', 79))
end
if ~(fileopen) then do
myerr = 'Couldn''t open "'destfile'" for writing.'; rc = 20; signal error
end
/*
** Write to/from names/addresses, subject and header
*/
if (args.HEADER) then do
if (symbol(hstem.'FROMNAME') = 'VAR') then do
from = value(hstem'.FROMNAME')
if (symbol(hstem'.FROMADDR') = 'VAR') then from = from || ' <' || value(hstem'.FROMADDR') || '>'
end
else do
from = head.FROMNAME
if (symbol('head.FROMADDR') = 'VAR') then from = from || ' <' || head.FROMADDR || '>'
end
call writeln(of, 'From: 'from)
if (symbol(hstem'.TONAME') = 'VAR') then do
to = value(hstem'.TONAME')
if (symbol(hstem'.TOADDR') = 'VAR') then to = to || ' <' || value(hstem'.TOADDR') || '>'
call writeln(of, 'To: 'to)
end
if (symbol(hstem'.SUBJECT') = 'VAR') then call writeln(of, 'Subject: 'value(hstem'.SUBJECT'))
else call writeln(of, 'Subject: 'head.SUBJECT)
if (symbol(tstem'.REPLYADDR') = 'VAR') then call writeln(of, 'Reply-To: 'value(tstem.'REPLYADDR'))
if (symbol(tstem'.COMMENT.COUNT') = 'VAR') then do
cnt = value(tstem'.COMMENT.COUNT')
if cnt > 0 then do
do i = 1 to cnt; call writeln(of, value(tstem'.COMMENT.'i)); end
end
end
end
/*
** Write body text
*/
if (symbol(tstem'.TEXT.COUNT') = 'VAR') then do
cnt = value(tstem'.TEXT.COUNT')
if (cnt > 0) then do
call writeln(of, '')
do i = 1 to cnt; call writeln(of, value(tstem'.TEXT.'i)); end
end
end
/*
** Check for message parts
*/
if (symbol(tstem'.PART.COUNT') = 'VAR') then do
parts = value(tstem'.PART.COUNT')
if (parts > 0) then do i = 1 to parts
select
when (symbol(tstem'.PART.'i'.BINARY') = 'VAR') then do
call writeln(of, '')
cnt = 0
if (symbol(tstem'.PART.'i'.BINARY.COMMENT.COUNT') = VAR) & (args.HEADER) then cnt = value(tstem'.PART.'i'.BINARY.COMMENT.COUNT')
if (cnt > 0) then do
call writeln(of, '')
do j = 1 to cnt
call writeln(of, value(tstem'.PART.'i'.BINARY.COMMENT.'j))
end
end
if (args.NOBIN) then call writeln(of, '[Binary part: 'value(tstem'.PART.'i'.BINARY')']')
else do
if (exists(value(tstem'.PART.'i'.BINARY'))) then do
address(command)
'Copy "'value(tstem'.PART.'i'.BINARY')'" TO "'downloadpath'" CLONE QUIET'
if (rc ~= 0) then do; myerr = 'Failed to copy binary part to download directory.'; rc = 20; signal error; end
address(bbsread)
call writeln(of, '[Binary part "' || value(tstem'.PART.'i'.BINARY') || '" copied to "' || downloadpath || '"]')
end
else call writeln(of, '[Binary part "' || value(tstem'.PART.'i'.BINARY') || '" was already deleted]')
end
end
when (symbol(tstem'.PART.'i'.COMMENT.COUNT') = 'VAR') & (args.HEADER) then do
cnt = value(tstem'.PART.'i'.COMMENT.COUNT')
if (cnt > 0) then do
do j = 1 to cnt
call writeln(of, value(tstem'.PART.'i'.COMMENT.'j))
end
end
end
when (symbol(tstem'.PART.'i'.TEXT.COUNT') = 'VAR') then do
cnt = value(tstem'.PART.'i'.TEXT.COUNT')
if (cnt > 0) then do
call writeln(of, '')
do j = 1 to cnt
call writeln(of, value(tstem'.PART.'i'.TEXT.'j))
end
end
end
otherwise do
call writeln(of, copies('=', 79))
usestem = tstem'.PART.'i'.MSG'
call savemsg(usestem, usestem)
end
end
end
end
return(0)
/****************************************************************************
********************* Substitute a string within a string *********************
******** Shamelessly ripped from Troels Walsted Hansen's UUDecode.thor ********
****************************************************************************/
substitute: interpret 'procedure expose 'globals
parse arg str, org, new
lastfound = 0
found = index(str, org)
do while found > lastfound
secondpart = substr(str, found + length(org))
firstpart = substr(str, 1, length(str) - length(substr(str, found)))
str = firstpart || new || secondpart
lastfound = found + length(new)
found = index(str, org, lastfound)
end
return(str)